C
C  MONOLITHIC VERSION OF POLISHING TOOL
C
      PROGRAM ISTLP
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.4
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
      INTEGER POLPTH(81),SRCPTH(81),I,IODPOL,IODSRC,
     +        RLBPTH(81),FMTPTH(81),SCRPTH(81),
     +        OPTPTH(81),IODOPT,NOOPTS(2),PLOPT(134)
 
      INTEGER TMPFIL, DESCO, DESCI, NERROR
      INTEGER TYPE, LENT, STRING(1322), STATUS, ZPLERR
      INTEGER GETARG,OPEN,CREATE,CTOI,EQUAL, ZTKGTI, ZTKPTI
      LOGICAL SCERR
 
      DATA (RLBPTH(I),I=1,11)/112,111,108,114,108,98,
     +        46,116,109,112,129/
     +     (FMTPTH(I),I=1,11)/112,111,108,102,109,116,
     +        46,116,109,112,129/
     +     (SCRPTH(I),I=1,11)/112,111,108,115,99,114,
     +        46,116,109,112,129/
      DATA  NOOPTS/45,129/
      DATA  SCERR/.FALSE./
 
C Initialise TIE
      CALL ZINIT
 
C Read paths from command file
 
      IF (GETARG(1,SRCPTH,81).EQ.-100) CALL NAMES(1,SRCPTH)
      IF (GETARG(2,POLPTH,81).EQ.-100) CALL NAMES(2,POLPTH)
      IF (GETARG(3,OPTPTH,81).EQ.-100) CALL NAMES(3,OPTPTH)
 
C Open required files
 
      IODSRC=OPEN(SRCPTH,0)
      IF (IODSRC.EQ.-1) CALL ERROR('Can''t Open source path')
      IODPOL=CREATE(POLPTH,1)
      IF (IODPOL.EQ.-1) CALL ERROR('Can''t Open output file')
C Default parameters are set up in block data POLBLK
      IF (OPTPTH(1).NE.129 .AND. EQUAL(OPTPTH,NOOPTS).EQ.-3) THEN
        IODOPT=OPEN(OPTPTH,0)
        IF (IODOPT.EQ.-1) CALL ERROR('Can''t Open option file')
C Setup user-specified option values
        CALL PLOPTF(IODOPT)
      END IF
      DO 100 I=4,10
        IF (GETARG(I,PLOPT,134).NE.-100)
     +     CALL POLOPT(PLOPT,.FALSE.)
 100  CONTINUE
 
      DESCI = ZTKGTI(0, IODSRC, -1)
      DESCO = ZTKPTI(0, IODPOL, ZTKGTI(2, 0, 0))
 
   10 CONTINUE
      CALL ZSCAN(TYPE, LENT, STRING, DESCI, STATUS)
      IF (STATUS.EQ.-1) SCERR=.TRUE.
      CALL ZUSCAN(TYPE, LENT, STRING, DESCO)
      IF (TYPE.NE.TZEOF) GOTO 10
 
      IF (SCERR) THEN
        CALL ZMESS('[ISTLP: Scanner erro'//'r(s) detected]', 2)
        CALL ZQUIT (-1)
      ENDIF
 
      NERROR = ZPLERR()
      IF (NERROR .NE. 0) THEN
        CALL ZCHOUT('[ISTLP: ',2)
        CALL ZPTINT(NERROR,1,2)
        CALL ZMESS('errors o'//'r warnings detected]', 2)
        CALL ZQUIT(-1002)
      ELSE
        CALL ZMESS('[ISTLP Normal Termination]', 2)
        CALL ZQUIT(-2)
      ENDIF
 
      END
C------------------------------------------------------
C
C PROMPT FOR A PATHNAME
C
      SUBROUTINE NAMES(NUMB,PATH)
 
      INTEGER NUMB,PATH(*)
      INTEGER I,PROMPT(22,4)
      INTEGER ZGTCMD
 
      DATA (PROMPT(I,1),I=1,14)/83,111,117,114,99,
     +        101,32,102,105,108,101,58,32,129/,
     +       (PROMPT(I,2),I=1,18)/80,111,108,105,115,104,
     +        101,100,32,111,117,116,112,117,116,58,
     +        32,129/
     +       (PROMPT(I,3),I=1,14)/79,112,116,105,111,110,
     +        32,102,105,108,101,58,32,129/
 
      CALL ZPRMPT(PROMPT(1,NUMB))
      I=ZGTCMD(PATH,0)
 
      END
